home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / lisp / disp-table.el < prev    next >
Lisp/Scheme  |  1993-07-23  |  5KB  |  142 lines
  1. ;;; disp-table.el --- functions for dealing with char tables.
  2.  
  3. ;; Copyright (C) 1987 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Howard Gayle
  6. ;; Maintainer: FSF
  7. ;; Keywords: i18n
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. ;;; Code:
  26.  
  27. (defun describe-display-table (dt)
  28.   "Describe the display table DT in a help buffer."
  29.   (with-output-to-temp-buffer "*Help*"
  30.     (princ "\nTruncation glyph: ")
  31.     (prin1 (aref dt 256))
  32.     (princ "\nWrap glyph: ")
  33.     (prin1 (aref dt 257))
  34.     (princ "\nEscape glyph: ")
  35.     (prin1 (aref dt 258))
  36.     (princ "\nCtrl glyph: ")
  37.     (prin1 (aref dt 259))
  38.     (princ "\nSelective display glyph sequence: ")
  39.     (prin1 (aref dt 260))
  40.     (princ "\nCharacter display glyph sequences:\n")
  41.     (let ((vector (make-vector 256 nil))
  42.       (i 0))
  43.       (while (< i 256)
  44.     (aset vector i (aref dt i))
  45.     (setq i (1+ i)))
  46.       (describe-vector vector))
  47.     (print-help-return-message)))
  48.  
  49. ;;;###autoload
  50. (defun describe-current-display-table ()
  51.    "Describe the display table in use in the selected window and buffer."
  52.    (interactive)
  53.    (describe-display-table
  54.     (or (window-display-table (selected-window))
  55.     buffer-display-table
  56.     standard-display-table)))
  57.  
  58. ;;;###autoload
  59. (defun make-display-table ()
  60.   "Return a new, empty display table."
  61.   (make-vector 261 nil))
  62.  
  63. ;;;###autoload
  64. (defun standard-display-8bit (l h)
  65.   "Display characters in the range L to H literally."
  66.   (while (<= l h)
  67.     (if (and (>= l ?\ ) (< l 127))
  68.     (if standard-display-table (aset standard-display-table l nil))
  69.       (or standard-display-table
  70.       (setq standard-display-table (make-vector 261 nil)))
  71.       (aset standard-display-table l (vector l)))
  72.     (setq l (1+ l))))
  73.  
  74. ;;;###autoload
  75. (defun standard-display-default (l h)
  76.   "Display characters in the range L to H using the default notation."
  77.   (while (<= l h)
  78.     (if (and (>= l ?\ ) (< l 127))
  79.     (if standard-display-table (aset standard-display-table l nil))
  80.       (or standard-display-table
  81.       (setq standard-display-table (make-vector 261 nil)))
  82.       (aset standard-display-table l nil))
  83.     (setq l (1+ l))))
  84.  
  85. ;;;###autoload
  86. (defun standard-display-ascii (c s)
  87.   "Display character C using string S."
  88.   (or standard-display-table
  89.       (setq standard-display-table (make-vector 261 nil)))
  90.   (aset standard-display-table c (apply 'vector (append s nil))))
  91.  
  92. ;;;###autoload
  93. (defun standard-display-g1 (c sc)
  94.   "Display character C as character SC in the g1 character set."
  95.   (or standard-display-table
  96.       (setq standard-display-table (make-vector 261 nil)))
  97.   (aset standard-display-table c
  98.     (vector (create-glyph (concat "\016" (char-to-string sc) "\017")))))
  99.  
  100. ;;;###autoload
  101. (defun standard-display-graphic (c gc)
  102.   "Display character C as character GC in graphics character set."
  103.   (or standard-display-table
  104.       (setq standard-display-table (make-vector 261 nil)))
  105.   (aset standard-display-table c
  106.     (vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
  107.  
  108. ;;;###autoload
  109. (defun standard-display-underline (c uc)
  110.   "Display character C as character UC plus underlining."
  111.   (or standard-display-table
  112.       (setq standard-display-table (make-vector 261 nil)))
  113.   (aset standard-display-table c
  114.     (vector (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))
  115.  
  116. ;; Allocate a glyph code to display by sending STRING to the terminal.
  117. ;;;###autoload
  118. (defun create-glyph (string)
  119.   (if (= (length glyph-table) 65536)
  120.       (error "No free glyph codes remain"))
  121.   (setq glyph-table (vconcat glyph-table (list string)))
  122.   (1- (length glyph-table)))
  123.  
  124. ;;;###autoload
  125. (defun standard-display-european (arg)
  126.   "Toggle display of European characters encoded with ISO 8859.
  127. When enabled, characters in the range of 160 to 255 display not
  128. as octal escapes, but as accented characters.
  129. With prefix argument, enable European character display iff arg is positive."
  130.   (interactive "P")
  131.   (if (or (< (prefix-numeric-value arg) 0)
  132.       (and (null arg)
  133.            (vectorp standard-display-table)
  134.            (>= (length standard-display-table) 161)
  135.            (equal (aref standard-display-table 160) [160])))
  136.       (standard-display-default 160 255)
  137.     (standard-display-8bit 160 255)))
  138.  
  139. (provide 'disp-table)
  140.  
  141. ;;; disp-table.el ends here
  142.